home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 2.iso / dist / fw_groff.idb / usr / freeware / bin / afmtodit.z / afmtodit
Text File  |  2002-04-08  |  9KB  |  332 lines
  1. #! /usr/bin/perl5 -P-
  2. # -*- Perl -*-
  3. # Copyright (C) 1989-2000 Free Software Foundation, Inc.
  4. #      Written by James Clark (jjc@jclark.com)
  5. #
  6. # This file is part of groff.
  7. #
  8. # groff is free software; you can redistribute it and/or modify it under
  9. # the terms of the GNU General Public License as published by the Free
  10. # Software Foundation; either version 2, or (at your option) any later
  11. # version.
  12. #
  13. # groff is distributed in the hope that it will be useful, but WITHOUT ANY
  14. # WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15. # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16. # for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License along
  19. # with groff; see the file COPYING.  If not, write to the Free Software
  20. # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  21.  
  22. $prog = $0;
  23. $prog =~ s@.*/@@;
  24.  
  25. do 'getopts.pl';
  26. do Getopts('ve:sd:i:a:n');
  27.  
  28. if ($opt_v) {
  29.     print "GNU afmtodit (groff) version 1.17.2\n";
  30.     exit 0;
  31. }
  32.  
  33. if ($#ARGV != 2) {
  34.     die "Usage: $prog [-nsv] [-d DESC] [-e encoding] [-i n] [-a angle] afmfile mapfile font\n";
  35. }
  36.  
  37. $afm = $ARGV[0];
  38. $map = $ARGV[1];
  39. $font = $ARGV[2];
  40. $desc = $opt_d || "DESC";
  41.  
  42. # read the afm file
  43.  
  44. open(AFM, $afm) || die "$prog: can't open \`$ARGV[0]': $!\n";
  45.  
  46. while (<AFM>) {
  47.     chop;
  48.     @field = split(' ');
  49.     if ($field[0] eq "FontName") {
  50.     $psname = $field[1];
  51.     }
  52.     elsif($field[0] eq "ItalicAngle") {
  53.     $italic_angle = -$field[1];
  54.     }
  55.     elsif ($field[0] eq "KPX") {
  56.     if ($#field == 3) {
  57.         push(kern1, $field[1]);
  58.         push(kern2, $field[2]);
  59.         push(kernx, $field[3]);
  60.     }
  61.     }
  62.     elsif ($field[0] eq "italicCorrection") {
  63.     $italic_correction{$field[1]} = $field[2];
  64.     }
  65.     elsif ($field[0] eq "leftItalicCorrection") {
  66.     $left_italic_correction{$field[1]} = $field[2];
  67.     }
  68.     elsif ($field[0] eq "subscriptCorrection") {
  69.     $subscript_correction{$field[1]} = $field[2];
  70.     }
  71.     elsif ($field[0] eq "StartCharMetrics") {
  72.     while (<AFM>) {
  73.         @field = split(' ');
  74.         last if ($field[0] eq "EndCharMetrics");
  75.         if ($field[0] eq "C") {
  76.         $c = -1;
  77.         $wx = 0;
  78.         $n = "";
  79.         $lly = 0;
  80.         $ury = 0;
  81.         $llx = 0;
  82.         $urx = 0;
  83.         $c = $field[1];
  84.         $i = 2;
  85.         while ($i <= $#field) {
  86.             if ($field[$i] eq "WX") {
  87.             $w = $field[$i + 1];
  88.             $i += 2;
  89.             }
  90.             elsif ($field[$i] eq "N") {
  91.             $n = $field[$i + 1];
  92.             $i += 2;
  93.             }
  94.             elsif ($field[$i] eq "B") {
  95.             $llx = $field[$i + 1];
  96.             $lly = $field[$i + 2];
  97.             $urx = $field[$i + 3];
  98.             $ury = $field[$i + 4];
  99.             $i += 5;
  100.             }
  101.             elsif ($field[$i] eq "L") {
  102.             push(ligatures, $field[$i + 2]);
  103.             $i += 3;
  104.             }
  105.             else {
  106.             while ($i <= $#field && $field[$i] ne ";") {
  107.                 $i++;
  108.             }
  109.             $i++;
  110.             }
  111.         }
  112.         if (!$opt_e && $c != -1) {
  113.             $encoding[$c] = $n;
  114.             $in_encoding{$n} = 1;
  115.         }
  116.         $width{$n} = $w;
  117.         $height{$n} = $ury;
  118.         $depth{$n} = -$lly;
  119.         $left_side_bearing{$n} = -$llx;
  120.         $right_side_bearing{$n} = $urx - $w;
  121.         }
  122.     }
  123.     }
  124. }
  125. close(AFM);
  126.  
  127. # read the DESC file
  128.  
  129. $sizescale = 1;
  130.  
  131. open(DESC, $desc) || die "$prog: can't open \`$desc': $!\n";
  132. while (<DESC>) {
  133.     next if /^#/;
  134.     chop;
  135.     @field = split(' ');
  136.     last if $field[0] eq "charset";
  137.     if ($field[0] eq "res") { $resolution = $field[1]; }
  138.     if ($field[0] eq "unitwidth") { $unitwidth = $field[1]; }
  139.     if ($field[0] eq "sizescale") { $sizescale = $field[1]; }
  140. }
  141. close(DESC);
  142.  
  143. if ($opt_e) {
  144.     # read the encoding file
  145.     
  146.     open(ENCODING, $opt_e) || die "$prog: can't open \`$opt_e': $!\n";
  147.     while (<ENCODING>) {
  148.     chop;
  149.     @field = split(' ');
  150.     if ($#field == 1) {
  151.         if ($field[1] >= 0 && defined $width{$field[0]}) {
  152.         $encoding[$field[1]] = $field[0];
  153.         $in_encoding{$field[0]} = 1;
  154.         }
  155.     }
  156.     }
  157.     close(ENCODING);
  158. }
  159.  
  160. # read the map file
  161.  
  162. open(MAP, $map) || die "$prog: can't open \`$map': $!\n";
  163. while (<MAP>) {
  164.     next if /^#/;
  165.     chop;
  166.     @field = split(' ');
  167.     if ($#field == 1 && $in_encoding{$field[0]}) {
  168.     if (defined $mapped{$field[1]}) {
  169.         warn "Both $mapped{$field[1]} and $field[0] map to $field[1]";
  170.     }
  171.     elsif ($field[1] eq "space") {
  172.         # the PostScript character "space" is automatically mapped
  173.         # to the groff character "space"; this is for grops
  174.         warn "you are not allowed to map to the groff character `space'";
  175.     }
  176.     elsif ($field[0] eq "space") {
  177.         warn "you are not allowed to map the PostScript character `space'";
  178.     }
  179.     else {
  180.         $nmap{$field[0]} += 0;
  181.         $map{$field[0],$nmap{$field[0]}} = $field[1];
  182.         $nmap{$field[0]} += 1;
  183.         $mapped{$field[1]} = $field[0];
  184.     }
  185.     }
  186. }
  187. close(MAP);
  188.  
  189. $italic_angle = $opt_a if $opt_a;
  190.  
  191. # print it all out
  192.  
  193. open(FONT, ">$font") || die "$prog: can't open \`$font' for output: $!\n";
  194. select(FONT);
  195.  
  196. print("name $font\n");
  197. print("internalname $psname\n") if $psname;
  198. print("special\n") if $opt_s;
  199. printf("slant %g\n", $italic_angle) if $italic_angle != 0;
  200. printf("spacewidth %d\n", do conv($width{"space"})) if defined $width{"space"};
  201.  
  202. if ($opt_e) {
  203.     $e = $opt_e;
  204.     $e =~ s@.*/@@;
  205.     print("encoding $e\n");
  206. }
  207.  
  208. if (!$opt_n && $#ligatures >= 0) {
  209.     print("ligatures");
  210.     foreach $lig (@ligatures) {
  211.     print(" $lig");
  212.     }
  213.     print(" 0\n");
  214. }
  215.  
  216. if ($#kern1 >= 0) {
  217.     print("kernpairs\n");
  218.     
  219.     for ($i = 0; $i <= $#kern1; $i++) {
  220.     $c1 = $kern1[$i];
  221.     $c2 = $kern2[$i];
  222.     if ($in_encoding{$c1} == 1 && $nmap{$c1} != 0
  223.         && $in_encoding{$c2} == 1 && $nmap{$c2} != 0) {
  224.         for ($j = 0; $j < $nmap{$c1}; $j++) {
  225.         for ($k = 0; $k < $nmap{$c2}; $k++) {
  226.             if ($kernx[$i] != 0) {
  227.             printf("%s %s %d\n",
  228.                    $map{$c1,$j},
  229.                    $map{$c2,$k},
  230.                    do conv($kernx[$i]));
  231.             }
  232.         }
  233.         }
  234.     }
  235.     }
  236. }
  237.  
  238. # characters not shorter than asc_boundary are considered to have ascenders
  239. $asc_boundary = $height{"t"} - 1;
  240.  
  241. # likewise for descenders
  242. $desc_boundary = $depth{"g"};
  243. $desc_boundary = $depth{"j"} if $depth{"j"} < $desc_boundary;
  244. $desc_boundary = $depth{"p"} if $depth{"p"} < $desc_boundary;
  245. $desc_boundary = $depth{"q"} if $depth{"q"} < $desc_boundary;
  246. $desc_boundary = $depth{"y"} if $depth{"y"} < $desc_boundary;
  247. $desc_boundary -= 1;
  248.  
  249. if (defined $height{"x"}) {
  250.     $xheight = $height{"x"};
  251. }
  252. elsif (defined $height{"alpha"}) {
  253.     $xheight = $height{"alpha"};
  254. }
  255. else {
  256.     $xheight = 450;
  257. }
  258.  
  259. $italic_angle = $italic_angle*3.14159265358979323846/180.0;
  260. $slant = sin($italic_angle)/cos($italic_angle);
  261. $slant = 0 if $slant < 0;
  262.  
  263. print("charset\n");
  264. for ($i = 0; $i < 256; $i++) {
  265.     $ch = $encoding[$i];
  266.     if ($ch ne "" && $ch ne "space") {
  267.     $map{$ch,"0"} = "---" if $nmap{$ch} == 0;
  268.     $type = 0;
  269.     $h = $height{$ch};
  270.     $h = 0 if $h < 0;
  271.     $d = $depth{$ch};
  272.     $d = 0 if $d < 0;
  273.     $type = 1 if $d >= $desc_boundary;
  274.     $type += 2 if $h >= $asc_boundary;
  275.     printf("%s\t%d", $map{$ch,"0"}, do conv($width{$ch}));
  276.     $italic_correction = 0;
  277.     $left_math_fit = 0;
  278.     $subscript_correction = 0;
  279.     if (defined $opt_i) {
  280.         $italic_correction = $right_side_bearing{$ch} + $opt_i;
  281.         $italic_correction = 0 if $italic_correction < 0;
  282.         $subscript_correction = $slant * $xheight * .8;
  283.         $subscript_correction = $italic_correction if
  284.         $subscript_correction > $italic_correction;
  285.         $left_math_fit = $left_side_bearing{$ch} + $opt_i;
  286.     }
  287.     if (defined $italic_correction{$ch}) {
  288.         $italic_correction = $italic_correction{$ch};
  289.     }
  290.     if (defined $left_italic_correction{$ch}) {
  291.         $left_math_fit = $left_italic_correction{$ch};
  292.     }
  293.     if (defined $subscript_correction{$ch}) {
  294.         $subscript_correction = $subscript_correction{$ch};
  295.     }
  296.     if ($subscript_correction != 0) {
  297.         printf(",%d,%d", do conv($h), do conv($d));
  298.         printf(",%d,%d,%d", do conv($italic_correction),
  299.            do conv($left_math_fit),
  300.            do conv($subscript_correction));
  301.     }
  302.     elsif ($left_math_fit != 0) {
  303.         printf(",%d,%d", do conv($h), do conv($d));
  304.         printf(",%d,%d", do conv($italic_correction),
  305.            do conv($left_math_fit));
  306.     }
  307.     elsif ($italic_correction != 0) {
  308.         printf(",%d,%d", do conv($h), do conv($d));
  309.         printf(",%d", do conv($italic_correction));
  310.     }
  311.     elsif ($d != 0) {
  312.         printf(",%d,%d", do conv($h), do conv($d));
  313.     }
  314.     else {
  315.         # always put the height in to stop groff guessing
  316.         printf(",%d", do conv($h));
  317.     }
  318.     printf("\t%d", $type);
  319.     printf("\t0%03o\t-- %s\n", $i, $ch);
  320.     for ($j = 1; $j < $nmap{$ch}; $j++) {
  321.         printf("%s\t\"\n", $map{$ch,$j});
  322.     }
  323.     }
  324.     if ($ch eq "space" && defined $width{"space"}) {
  325.     printf("space\t%d\t0\t0%03o\n", do conv($width{"space"}), $i);
  326.     }
  327. }
  328.  
  329. sub conv {
  330.     $_[0]*$unitwidth*$resolution/(72*1000*$sizescale) + ($_[0] < 0 ? -.5 : .5);
  331. }
  332.